MODULE Miller_f_Win;
(* Dieses Modul kann nur mit aktivierter Option f (Coprozessor) compiliert
	 werden (sonst existiert das Pseudo-Modul FPU nicht). Ohne direkte Verwendung
	 der FLine-FPU w„re das Programm zu langsam. *)

FROM FPU IMPORT SIN, COS, EXTEND, WHOLE;
IMPORT AES, appl, evnt, graf, MathLib0, VDI, v, vr, vs, vsf, vsl, wind;
FROM SYSTEM IMPORT ADR;

CONST
	cStep = 0.03;
	N = VAL (LONGINT, TRUNC (200.0 * MathLib0.pi / cStep + 0.5));

VAR
	hdl: SHORTINT;

PROCEDURE init(): BOOLEAN;

	TYPE
		tIn = ARRAY [0..10] OF SHORTINT;

	VAR
		in: tIn;
		out: ARRAY [0..56] OF SHORTINT;
		j: SHORTINT;

	BEGIN
		IF appl.init () < 0 THEN RETURN FALSE END;
		(*VDI init*)
		in := tIn{1 BY 10, 2};
		hdl := graf.handle (j, j, j, j);
		v.opnvwk (in, hdl, out);
		IF hdl > 0 THEN
			RETURN TRUE
		ELSE
			appl.exit;
			RETURN FALSE
		END;
	END init;

VAR
	wname: ARRAY [0..49] OF CHAR;

PROCEDURE intersect (VAR w1, w2: AES.tRect): BOOLEAN;

	VAR
		(*$Reg*) xmin, (*$Reg*) ymin,
		(*$Reg*) xmax, (*$Reg*) ymax,
		(*$Reg*) x2, (*$Reg*) y2: SHORTINT;

	BEGIN
		WITH w1 DO
			x2 := x+w;
			y2 := y+h;
			xmin := x;
			ymin := y;
		END;
		WITH w2 DO
			IF x > xmin THEN xmin := x END;
			IF y > ymin THEN ymin := y END;
			xmax := x+w; IF x2 < xmax THEN xmax := x2 END;
			ymax := y+h; IF y2 < ymax THEN ymax := y2 END;
			w2 := AES.tRect{xmin, ymin, xmax-xmin, ymax-ymin};
			RETURN ~((w <= 0) OR (h <= 0));
		END
	END intersect;

PROCEDURE Main;

	CONST
		cPoints = 100;

	TYPE
		tVRect = ARRAY [0..1] OF VDI.tPoint;

	VAR
		w2, h2: LONGINT;
		(*$Reg*) ox, (*$Reg*) oy: LONGINT;
		(*$Reg*) a,
		(*$Reg*) b,
		(*$Reg*) t: LONGREAL;
		(*$R+*) i: LONGINT;
		(*$Reg*) j: SHORTINT;
		Points: ARRAY [0..cPoints-1] OF VDI.tPoint;
		color: SHORTINT;
		wrect, desk: AES.tRect;
		fulled: BOOLEAN;
		FParam: wind.tFParam;
		w: SHORTINT;
		stop, resize, reset: BOOLEAN;
	
	PROCEDURE redraw (wrect: AES.tRect);

		VAR
			vrect: tVRect;
			rect: AES.tRect;

		BEGIN
			wind.update (wind.BegUpdate);
			IF intersect (desk, wrect) THEN
				v.hidec (hdl);
				wind.get (w, wind.FirstXYWH, rect);
				WHILE (rect.w > 0) & (rect.h > 0) DO
					IF intersect (wrect, rect) THEN
						WITH rect DO vrect := tVRect{{x,y},{x+w-1,y+h-1}} END;
						vs.clip (hdl, TRUE, vrect);
						vr.recfl (hdl, vrect);
					END;
					wind.get (w, wind.NextXYWH, rect);
				END;
				v.showc (hdl, FALSE);
			END;
			wind.update (wind.EndUpdate);
		END redraw;

	PROCEDURE draw (n: SHORTINT);

		CONST
			cMinW = 160;
			cMinH = 160;

		VAR
			msg: evnt.tMsg;
			event: BITSET;
			vrect: tVRect;
			rect: AES.tRect;

		BEGIN
			wind.update (wind.BegUpdate);
			v.hidec (hdl);
			wind.get (w, wind.FirstXYWH, rect);
			WHILE (rect.w > 0) & (rect.h > 0) DO
				IF intersect (desk, rect) THEN
					WITH rect DO vrect := tVRect{{x,y},{x+w-1,y+h-1}} END;
					vs.clip (hdl, TRUE, vrect);
					v.pline (hdl, n, Points);
				END;
				wind.get (w, wind.NextXYWH, rect);
			END;
			v.showc (hdl, FALSE);
			wind.update (wind.EndUpdate);
			AES.intin[14] := 20;
			AES.intin[15] := 0;
			AES.addrin[0] := ADR (msg);
			event := evnt.pmulti ({evnt.Mesag, evnt.Timer});
			IF evnt.Mesag IN event THEN
				IF msg.win = w THEN
					CASE msg.type OF
					| evnt.Closed:
							stop := TRUE;
					| evnt.Topped:
							FParam.handle := w;
							wind.set (w, wind.Top, FParam.rect);
					| evnt.Fulled:
							IF fulled THEN
								wind.get (w, wind.PrevXYWH, FParam.rect);
								fulled := FALSE;
							ELSE
								wind.get (w, wind.FullXYWH, FParam.rect);
								fulled := TRUE;
							END;
							wind.set (w, wind.CurrXYWH, FParam.rect);
							resize := TRUE; reset := TRUE;
					| evnt.Moved, evnt.Sized:
							FParam.coord := msg.coord;
							WITH FParam.coord DO
								IF w < cMinW THEN w := cMinW END;
								IF h < cMinH THEN h := cMinH END;
							END;
							wind.set (w, wind.CurrXYWH, FParam.rect);
							resize := TRUE;
							reset := msg.type = evnt.Sized;
					| evnt.Redraw:
							redraw (msg.coord);
							VOID (vsl.color (hdl, VDI.Black));
							color := VDI.Black;
					END
				END
			END;
		END draw;

	BEGIN
		IF init() THEN
			graf.mouseform (graf.Arrow);
			wind.get (0, wind.WorkXYWH, desk);
			w := wind.create (
				 {wind.cName, wind.cClose, wind.cFull, wind.cMove, wind.cSize},
				 desk);
			wname := ' Miller - mit H„nisch Modula-2 programmiert ';
			FParam.string := ADR (wname);
			wind.set (w, wind.Name, FParam.rect);
			wrect := desk;
			WITH wrect DO
				w := w DIV 2;
				h := h DIV 2;
			END;
			fulled := FALSE;
			wind.open (w, wrect);
			VOID (vsf.color (hdl, VDI.White));
			color := VDI.Black;
			stop := FALSE; resize := TRUE; reset := FALSE;
			LOOP
				t := 0.0;
				VOID (vsl.color (hdl, color));
				j := 0;
				i := 0;
				WHILE i <= N DO
					INC (i);
					IF stop THEN EXIT END;
					IF resize THEN
						wind.get (w, wind.WorkXYWH, wrect);
						WITH wrect DO
							w2 := w DIV 2;
							h2 := h DIV 2;
							a := EXTEND (w2) / 2.0;
							b := EXTEND (h2) / 1.3;
							ox := x + w2;
							oy := y + h2;
						END;
						resize := FALSE;
						j := 0;
					END;
					IF reset THEN
						wind.get (w, wind.WorkXYWH, wrect);
						redraw (wrect);
						VOID (vsl.color (hdl, VDI.Black));
						color := VDI.Black;
						j := 0; i := 0; t := 0.0;
						reset := FALSE;
					END;
					INC (t, cStep);
					Points[j] := VDI.tPoint{
							ox + WHOLE (a * (SIN (0.99 * t) - 0.7 * COS (3.01 * t))),
							oy + WHOLE (b * (COS (1.01 * t) + 0.1 * SIN (15.03 * t)))
					};
					INC (j);
					IF j = cPoints THEN
						draw (cPoints);
						Points[0] := Points[cPoints-1];
						j := 1
					END
				END;
				IF j > 1 THEN
					draw (j)
				END;
				IF color = VDI.Black THEN
					color := VDI.White
				ELSE
					color := VDI.Black
				END;
			END;
			wind.close (w);
			wind.delete (w);
			v.clsvwk (hdl);
			appl.exit ()
		END;
	END Main;

BEGIN
	Main
END Miller_f_Win.
		
	
	